home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
techjock.arc
/
WINTTT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-11-18
|
14KB
|
476 lines
{$S-,R-,V-,D-,T-}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
{ TechnoJocks Turbo Toolkit v4.00 Released: Feb 1, 1988 }
{ }
{ Module: WinTTT -- screen saving, cursor and windowing procs }
{ }
{ Copyright R. D. Ainsbury (c) 1986 }
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
unit WinTTT;
interface
uses CRT,FastTTT,DOS;
Type
Direction = (Up, Down, Left, Right);
Procedure Attrib(X1,Y1,X2,Y2,F,B:byte);
Procedure SizeCursor(ScanTop,ScanBot:byte);
Procedure FindCursor(var X,Y,ScanTop,ScanBot:byte);
Procedure PosCursor(X,Y: integer);
Procedure Fullcursor;
Procedure HalfCursor;
Procedure OnCursor;
Procedure OffCursor;
Procedure SaveScreen(Page:byte);
Procedure RestoreScreen(Page:byte);
Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
Procedure SlideRestoreScreen(Page:byte;Way:Direction);
Procedure DisposeScreen(Page:byte);
Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
Procedure ScrollUp(X1,Y1,X2,Y2:byte);
Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
Procedure Mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
Procedure GrowMkwin(x1,y1,x2,y2,F,B,boxtype:integer);
Procedure Rmwin;
Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
Procedure TempMessage(X,Y,F,B:integer;St:string);
implementation
Const
Max_Windows = 10; {Change this constant as necessary}
Max_Screens = 10; {Change this constant as necessary}
WindowCounter : byte = 0;
ScreenCounter : byte = 0;
DisplayLines = 25; {Change this constant as necessary}
Screen_Size = 4000; {Change this to 8000 for VGA 50 line Mode}
MonoAdr =$b000;
Type
Image = array[1..DisplayLines,1..80] of word;
ScreenImage = record
ScreenSnap: Image;
CursorX : byte;
CursorY : byte;
ScanTop : byte;
ScanBot : byte;
end;
ScreenPtr = ^ScreenImage;
WindowImage = record
ScreenPtr: Pointer; {pointer to screen data}
Coord : array[1..4] of byte; {window coords}
CursorX : byte; {cursor location}
CursorY : byte;
ScanTop : byte; {cursor shape}
ScanBot : byte;
end;
WindowPtr = ^WindowImage;
Var
Screen : array[1..Max_Screens] of ScreenPtr;
Win : array[1..Max_Windows] of WindowPtr;
{$L WINTTT}
{$F+}
Procedure Attribute(Col,Row,Attr:byte; Number:Word); external;
Procedure MoveFromScreen(var Source,Dest;Length:Word); external;
Procedure MoveToScreen(var Source,Dest; Length:Word); external;
{$F-}
Procedure WinTTT_Error(No : byte);
{Display error message and halts program}
var Msg : String;
begin
Case No of
1 : Msg := '1) -- Max_Screens exceeded.';
2 : Msg := '2) -- Screen not previously saved, cannot Restore.';
3 : Msg := '3) -- Screen not previously saved, cannot Dispose.';
4 : Msg := '4) -- Max_Windows exceeded.';
5 : Msg := '5) -- Insufficient memory to create window.';
else Msg := '?) -- Utterly confused';
end; {Case}
Msg := 'Fatal Error (WinTTT No. '+Msg;
Writeln(Msg);
Delay(5000); {display long enough to read if child process}
Halt;
end;
Procedure Attrib(X1,Y1,X2,Y2,F,B:byte);
{changes color attrib at specified coords}
var
I,X,A : byte;
begin
A := Attr(F,B);
X := Succ(X2-X1);
For I := Y1 to Y2 do
Attribute(X1,I,A,X);
end; {Proc Attrib}
Procedure FindCursor(var X,Y,ScanTop,ScanBot:byte);
var
Reg : registers;
begin
Reg.Ax := $0F00; {get page in Bx}
Intr($10,Reg);
Reg.Ax := $0300;
Intr($10,Reg);
With Reg do
begin
X := lo(Dx) + 1;
Y := hi(Dx) + 1;
ScanTop := Hi(Cx) and $0F;
ScanBot := Lo(Cx) and $0F;
end;
end;
Procedure PosCursor(X,Y: integer);
var Reg : registers;
begin
Reg.Ax := $0F00; {get page in Bx}
Intr($10,Reg);
with Reg do
begin
Ax := $0200;
Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
end;
Intr($10,Reg);
end;
Procedure SizeCursor(ScanTop,ScanBot:byte);
var Reg : registers;
begin
with Reg do
begin
ax := 1 shl 8;
cx := Scantop shl 8 + Scanbot;
INTR($10,Reg);
end;
end;
Procedure HalfCursor;
begin
If BaseOfScreen = MonoAdr then
SizeCursor(9,14)
else
SizeCursor(5,7);
end; {Proc HalfCursor}
Procedure Fullcursor;
begin
If BaseOfScreen = MonoAdr then
SizeCursor(0,14)
else
SizeCursor(0,7);
end;
Procedure OnCursor;
begin
If BaseOfScreen = MonoAdr then
SizeCursor(13,14)
else
SizeCursor(6,7);
end;
Procedure OffCursor;
begin
Sizecursor(14,0);
end;
Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
var
I : integer;
S : string;
begin
Attrib(X1,Y1,X2,Y2,F,B);
S := Replicate(Succ(X2-x1),C);
For I := Y1 to Y2 do
PlainWrite(X1,I,S);
end;
{
****************************
* Screen Saving Procedures *
****************************
}
Procedure Initialize_Screens;
{set Pointers to nil for validity check in RestoreScreen}
Var I : integer;
begin
For I := 1 to Max_Screens do
Screen[I] := nil;
end;
Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
{transfers data from video display to Dest}
var
I,width : byte;
ScreenAdr: integer;
begin
width := succ(X2- X1);
For I := Y1 to Y2 do
begin
SCreenAdr := Pred(I)*160 + Pred(X1)*2;
MoveFromScreen(Mem[BaseOfScreen:ScreenAdr],
Mem[seg(Dest):ofs(dest)+(I-Y1)*width*2],
width);
end;
end;
Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
{restores data from Source and transfers to video display}
var
I,width : byte;
ScreenAdr: integer;
begin
width := succ(X2- X1);
For I := Y1 to Y2 do
begin
ScreenAdr := Pred(I)*160 + Pred(X1)*2;
MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*width*2],
Mem[BaseOfScreen:ScreenAdr],
width);
end;
end;
Procedure SaveScreen(Page:byte);
{Save screen display and cursor details}
begin
If (Page > Max_Screens) then
WinTTT_Error(1);
If MaxAvail < Screen_Size then
WinTTT_Error(6);
GetMem(Screen[Page],Screen_Size);
MoveFromScreen(Mem[BaseOfScreen:0],Screen[Page]^.ScreenSnap, Screen_Size div 2);
FindCursor(Screen[Page]^.CursorX, {Save Cursor posn. and shape}
Screen[Page]^.CursorY,
Screen[Page]^.ScanTop,
Screen[Page]^.ScanBot);
end;
Procedure RestoreScreen(Page:byte);
{Display a screen that was previously saved}
begin
If Screen[Page] = nil then
WinTTT_Error(2);
MoveToScreen(Screen[Page]^.ScreenSnap,mem[BaseOfScreen:0], Screen_Size div 2);
PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
end; {Proc RestoreScreen}
Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
{Move from heap to screen, part of saved screen}
Var
I,width : byte;
ScreenAdr,
PageAdr : integer;
begin
If Screen[Page] = nil then
WinTTT_Error(2);
Width := succ(X2- X1);
For I := Y1 to Y2 do
begin
ScreenAdr := pred(Y+I-Y1)*160 + Pred(X)*2;
PageAdr := Pred(I)*160 + Pred(X1)*2;
MoveToScreen(Mem[Seg(Screen[Page]^):ofs(Screen[Page]^)+PageAdr],
Mem[BaseOfScreen:ScreenAdr],
width);
end;
end;
Procedure SlideRestoreScreen(Page:byte;Way:Direction);
{Display a screen that was previously saved, with fancy slide}
Var I : byte;
begin
If Screen[Page] = nil then
WinTTT_Error(2);
Case Way of
Up : begin
For I := DisplayLines downto 1 do
begin
PartRestoreScreen(Page,
1,1,80,succ(DisplayLines -I),
1,I);
Delay(50);
end;
end;
Down : begin
For I := 1 to DisplayLines do
begin
PartRestoreScreen(Page,
1,succ(DisplayLines -I),80,DisplayLines,
1,1);
Delay(50); {savor the moment!}
end;
end;
Left : begin
For I := 1 to 80 do
begin
PartRestoreScreen(Page,
1,1,I,DisplayLines,
succ(80-I),1);
end;
end;
Right : begin
For I := 80 downto 1 do
begin
PartRestoreScreen(Page,
I,1,80,DisplayLines,
1,1);
end;
end;
end; {case}
PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
end; {Proc SlideRestoreScreen}
Procedure DisposeScreen(Page:byte);
{Free memory that was allocated by SvaeScreen}
begin
If Screen[Page] = nil then
WinTTT_Error(3);
FreeMem(Screen[Page],Screen_Size);
end;
Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
{copies text and attributes from one part of screen to another}
Var
I,width : byte;
SourceAdr,
TargetAdr : integer;
TempLine : array[1..160] of byte;
begin
Width := succ(X2- X1);
For I := Y1 to Y2 do
begin
SourceAdr := Pred(I)*160 + Pred(X1)*2;
TargetAdr := Pred(Y+I-Y1)*160 + Pred(X)*2;
MoveFromScreen(Mem[BaseOfScreen:SourceAdr],
TempLine,
width);
MoveToScreen(TempLine,
Mem[BaseOfScreen:TargetAdr],
width);
end;
end; {CopyScreenBlock}
Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
{Moves text and attributes from one part of screen to another,
replacing with Replace_Char}
const
Replace_Char = ' ';
Var
I,width : byte;
SourceAdr,
TargetAdr : integer;
TempLine : array[1..160] of byte;
begin
Width := succ(X2- X1);
For I := Y1 to Y2 do
begin
SourceAdr := Pred(I)*160 + Pred(X1)*2;
TargetAdr := Pred(Y+I-Y1)*160 + Pred(X)*2;
MoveFromScreen(Mem[BaseOfScreen:SourceAdr],
TempLine,
width);
PlainWrite(X1,I,replicate(succ(X2-X1),Replace_Char));
MoveToScreen(TempLine,
Mem[BaseOfScreen:TargetAdr],
width);
end;
end; {Proc MoveScreenBlock}
Procedure ScrollUp(X1,Y1,X2,Y2:byte);
{used for screen scrolling, uses Copy & Plainwrite rather than Move for speed}
const
Replace_Char = ' ';
begin
CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
PlainWrite(X1,Y2,replicate(succ(X2-X1),Replace_Char));
end;
{
****************************
* Windowing Procedures *
****************************
}
procedure CreateWin(x1,y1,x2,y2,F,B,boxtype:integer);
{called by MkWin and GrowMkWin}
begin
If WindowCounter >= Max_Windows then
WinTTT_Error(4);
WindowCounter := WindowCounter + 1;
If MaxAvail < sizeOf(Win[WindowCounter]^) then
WinTTT_Error(5);
GetMem(Win[WindowCounter],sizeof(Win[WindowCounter]^)); {allocate space}
If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
WinTTT_Error(5);
GetMem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
with Win[WindowCounter]^ do
begin
Coord[1] := X1;
Coord[2] := Y1;
Coord[3] := X2;
Coord[4] := Y2;
FindCursor(CursorX,CursorY,ScanTop,ScanBot);
end; {with}
end; {Proc CreateWin}
procedure mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
{Main procedure for creating window}
begin
CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
FBox(x1,y1,x2,y2,F,B,boxtype);
end;
procedure GrowMKwin(x1,y1,x2,y2,F,B,boxtype:integer);
{same as MKwin but window explodes}
begin
CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
GrowFBox(x1,y1,x2,y2,F,B,boxtype);
end;
Procedure RmWin;
begin
If WindowCounter > 0 then
begin
with Win[WindowCounter]^ do
begin
PartRestore(Coord[1],Coord[2],Coord[3],Coord[4],ScreenPtr^);
PosCursor(CursorX,CursorY);
SizeCursor(ScanTop,ScanBot);
FreeMem(ScreenPtr,succ(Coord[4]-coord[2])*succ(coord[3]-coord[1])*2);
FreeMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
end; {with}
WindowCounter := WindowCounter - 1;
end;
end;
procedure TempMessage(X,Y,F,B:integer;St:string);
var
CX,CY,CT,CB,I,locC:integer;
SavedLine : array[1..160] of byte;
Ch :char;
begin
PartSave(X,Y,1,length(St),SavedLine);
{FindCursor(CX,CY,CT,CB);}
WriteAT(X,Y,F,B,St);
Ch := ReadKey;
PartRestore(X,Y,X,Y+length(St),SavedLine);
{
SizeCursor(CT,CB);
PosCursor(CX,CY);
}
end;
begin
Initialize_Screens;
end.